home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / compmrk.com / TPALLOC.ZIP / DEMO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-11-04  |  2.2 KB  |  83 lines
  1. {$R-,S-}
  2.  
  3. program Demo;
  4.   {-Demonstrates use of TPALLOC}
  5.  
  6. uses
  7.   TpAlloc;
  8.  
  9. type
  10.   LongPtr = ^LongInt;
  11. var
  12.   I, Elements, ErrorCount : LongInt;
  13.   LongArray : LongPtr;
  14.   LongArrayAddr : LongInt;
  15.  
  16.   function GetElementPtr(I : LongInt) : LongPtr;
  17.     {-Return a pointer to the I'th element of our 0-based array}
  18.   begin
  19.     {Notes:
  20.       1) Subtract 1 from I if array is 1-based.
  21.       2) LongArrayAddr could be replaced with 'Linear(LongArray)', but this
  22.          is much faster.}
  23.     GetElementPtr := LinearToPointer(LongArrayAddr+(I*SizeOf(LongInt)));
  24.   end;
  25.  
  26.   function GetElement(I : LongInt) : LongInt;
  27.     {-Return the I'th element of our 0-based array}
  28.   begin
  29.     GetElement := GetElementPtr(I)^;
  30.   end;
  31.  
  32.   procedure PutElement(I, Value : LongInt);
  33.     {-Set the I'th element of our 0-based array to Value}
  34.   begin
  35.     GetElementPtr(I)^ := Value;
  36.   end;
  37.  
  38. begin
  39.   WriteLn('MaxAvail = ', MaxAvail);
  40.  
  41.   {allocate as large an array of longints as possible}
  42.   Elements := MaxAvail div SizeOf(LongInt);
  43.   HugeGetMem(LongArray, Elements * SizeOf(LongInt));
  44.   if LongArray = nil then begin
  45.     WriteLn('Unable to allocate array of ', Elements, ' elements');
  46.     Halt(1);
  47.   end;
  48.  
  49.   {this saves us from recomputing Linear(LongArray) repeatedly}
  50.   LongArrayAddr := Linear(LongArray);
  51.  
  52.   {show memory status}
  53.   WriteLn('Allocated ', Elements * SizeOf(LongInt), ' bytes');
  54.   WriteLn('MaxAvail = ', MaxAvail);
  55.   WriteLn('Successfully allocated array of ', Elements, ' elements');
  56.  
  57.   {initialize the array}
  58.   WriteLn('Initializing array...');
  59.   for I := 0 to Elements-1 do
  60.     PutElement(I, I);
  61.  
  62.   {validate the array contents}
  63.   WriteLn('Validating array contents...');
  64.   ErrorCount := 0;
  65.   for I := 0 to Elements-1 do
  66.     if GetElement(I) <> I then begin
  67.       WriteLn('Error at element ', I, ':  should be ', I, ', is ',
  68.         GetElement(I));
  69.       Inc(ErrorCount);
  70.     end;
  71.  
  72.   {show status}
  73.   if ErrorCount = 0 then
  74.     WriteLn('No errors found')
  75.   else
  76.     WriteLn(ErrorCount, ' errors found');
  77.  
  78.   {release the memory}
  79.   WriteLn('Releasing memory...');
  80.   HugeFreeMem(LongArray, Elements * SizeOf(LongInt));
  81.   WriteLn('MaxAvail = ', MaxAvail);
  82. end.
  83.